*
* $Id$
*
* $Log: mzlift.F,v $
* Revision 1.1.1.1  2002/06/16 15:18:49  hristov
* Separate distribution  of Geant3
*
* Revision 1.1.1.1  1999/05/18 15:55:23  fca
* AliRoot sources
*
* Revision 1.2  1996/04/18 16:11:37  mclareni
* Incorporate changes from J.Zoll for version 3.77
*
* Revision 1.1.1.1  1996/03/06 10:47:18  mclareni
* Zebra
*
*
#include "zebra/pilot.h"
      SUBROUTINE MZLIFT (IXDIV,LP,LSUPP,JBIAS,NAME,NZERO)

C-    Lift a bank, user called

#include "zebra/zmach.inc"
#include "zebra/zstate.inc"
#include "zebra/zunit.inc"
#include "zebra/zvfaut.inc"
#include "zebra/mqsys.inc"
#include "zebra/eqlqmst.inc"
#include "zebra/eqlqform.inc"
#include "zebra/mzcl.inc"
#include "zebra/mzcn.inc"
#include "zebra/mzct.inc"
C--------------    End CDE                             --------------
      DIMENSION    IXDIV(9), LP(9), LSUPP(9), NAME(9)
#if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
      DIMENSION    NAMESR(2)
      DATA  NAMESR / 4HMZLI, 4HFT   /
#endif
#if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
      DATA  NAMESR / 6HMZLIFT /
#endif
#if !defined(CERNLIB_QTRHOLL)
      CHARACTER    NAMESR*8
      PARAMETER   (NAMESR = 'MZLIFT  ')
#endif

#include "zebra/q_jbit.inc"
#include "zebra/q_jbyt.inc"
#include "zebra/q_sbyt.inc"
#include "zebra/q_shiftl.inc"
#include "zebra/q_locf.inc"


#include "zebra/qtrace.inc"
#if defined(CERNLIB_QDEBUG)
      IF (IQVSTA.NE.0)       CALL ZVAUTX
#endif

C--                Copy parameters

      IF (JBIAS.NE.63)  THEN
          NQBIA = JBIAS
          NIO   = JBYT (NAME(5),12,4)
          CALL UCOPY (NAME,NQID,NIO+5)
          IF (NIO.NE.0)  NQIOSV(1)=0
        ENDIF

      JDV   = IXDIV(1)
      LQSUP = LSUPP(1)
      IF (NQBIA.GE.2)  LQSUP = 0
      ICHORG = NQIOCH(1)
      NTOT   = NQNL + NQND + 10

      IF (JDV.EQ.-7)                 GO TO 24
      IF (JBYT(JDV,27,6).NE.JQSTOR)  GO TO 22
      JQDIVI = JBYT (JDV,1,26)
      IF (JQDIVI.LT.21)              GO TO 23
   22 CALL MZSDIV (JDV,0)
   23 CALL MZCHNB (LP)
   24 CONTINUE

C--                Check  bank parameters

#if defined(CERNLIB_QDEBUG)
      J = JBYT (NQID,IQBITW-7,8)
      IF (J.EQ.0)                  GO TO 91
      IF (J.EQ.255)                GO TO 91
      IF (NTOT.GE.LQSTA(KQT+21))      GO TO 91
      IF (NQNS.GT.NQNL)            GO TO 91
      IF (NQNS.LT.0)               GO TO 91
      IF (NQNL.GT.64000)           GO TO 91
      IF (NQND.LT.0)               GO TO 91
      IF (NQBIA.GE.3)              GO TO 91

      IF (LQSUP.EQ.0)              GO TO 25
      CALL MZCHLS (-7,LQSUP)
      IF (IQFOUL.NE.0)             GO TO 92
      IF (NQBIA.EQ.1)              GO TO 26
      IF (JBIT(IQ(KQS+LQSUP),IQDROP).NE.0)  GO TO 92
      IF (IQNS+NQBIA.LT.0)         GO TO 93
      GO TO 26

   25 IF (NQBIA.LE.0)              GO TO 92
   26 CONTINUE
#endif

C----       Find   LNEXT,  future 'next' bank
C-                 LSAME,  a bank in the same linear structure
C-                    LS,  division selecting bank
C-                   IDN,  numeric ID

      IDN   = 1
      LS    = LQSUP
      LSAME = LQSUP
      LNEXT = LQSUP
      IF (NQBIA.GT.0)              GO TO 38
      LNEXT = LQ(KQS+LNEXT+NQBIA)
      IF (LNEXT.EQ.0)              GO TO 36
      LSAME = LNEXT
      LS    = LNEXT
#if defined(CERNLIB_QDEBUG)
      CALL MZCHLS (-7,LNEXT)
      IF (IQFOUL.NE.0)             GO TO 94
#endif
      IDN = IQ(KQS+LNEXT-5) + 1
      GO TO 39

   36 IF (NQBIA.EQ.0)              GO TO 37
      LSAME = 0
      IDN   = -NQBIA
      GO TO 39

   37 IDN = IQ(KQS+LSAME-5) + 1
      GO TO 39

   38 IF (LNEXT.NE.0)  IDN=IQ(KQS+LNEXT-5)+1
   39 CONTINUE

C----              Ready I/O characteristic

      IF (ICHORG.LT.0)             GO TO 47

C--                Immediate

      IF (ICHORG.LT.8)  THEN
          NQNIO = 0
          NQIOCH(1) = ISHFTL (ICHORG, 16)
          GO TO 49
        ENDIF

C--                Copy characteristic from sister bank

      IF (ICHORG-11)         45, 43, 47
   43 IF (LSAME.EQ.0)              GO TO 45
#if !defined(CERNLIB_QDEBUG)
      NQNIO = JBYT (IQ(KQS+LSAME),19,4)
      IQLN  = LSAME - (NQNIO+IQ(KQS+LSAME-3)+1)
#endif
#if defined(CERNLIB_QDEBUG)
      NQNIO = IQNIO
#endif
      IF (NQNIO.EQ.0)  THEN
          NQIOCH(1) = LQ(KQS+IQLN)
          GO TO 49
        ELSE
          CALL UCOPY (LQ(KQS+IQLN),NQIOCH,NQNIO+1)
          NQIOSV(1) = 0
          GO TO 49
        ENDIF

C--                Find index to characteristic according to IDH

   45 LID  = LQFORM
      IF (LID.EQ.0)                GO TO 95
      LIOD = LQ(KQSP+LID-2)
      IF (NQID.LT.0)  LID=LQ(KQSP+LID)

C--                Same as last

      IF (NQID.EQ.IQ(KQSP+LID+3))  THEN
          IXIO = IQ(KQSP+LID+2)
        ELSE

C--                Search

          N = IQ(KQSP+LID+1)
          IF (N.EQ.0)              GO TO 95
          J = IUCOMP (NQID,IQ(KQSP+LID+4),N)
          IF (J.EQ.0)              GO TO 95

          LIX  = LQ(KQSP+LID-1)
          IXIO = IQ(KQSP+LIX+J)
          IQ(KQSP+LID+2) = IXIO
          IQ(KQSP+LID+3) = NQID
        ENDIF

      NQNIO = JBYT (IQ(KQSP+LIOD+IXIO+1),7,5) - 1
      GO TO 48

C--                Parameter is characteristic or index

   47 J     = JBYT (ICHORG,1,6)
      NQNIO = JBYT (ICHORG,7,5) - 1
      IOTH  = JBYT (ICHORG,12,5)
      IF (J.EQ.1)  THEN
          IF (NQNIO.NE.IOTH)       GO TO 96
          GO TO 49
        ENDIF

C--                Index

      IF (J.NE.2)                  GO TO 96
      IF (IOTH.NE.0)               GO TO 96
      IXIO = JBYT (ICHORG,17,16)
      IF (IXIO.EQ.0)               GO TO 96

      LIOD = LQ(KQSP+LQFORM-2)
      IF (IXIO.GE.IQ(KQSP+LIOD+1))    GO TO 96

C--                Same characteristic as previously lifted bank

   48 IF (IXIO.EQ.NQIOSV(1))  THEN
          NQIOCH(1) = NQIOSV(2)
          GO TO 49
        ENDIF

C--                Copy characteristic

      NQIOSV(1) = 0
      IF (NQNIO.GE.16)             GO TO 96
      CALL UCOPY (IQ(KQSP+LIOD+IXIO+1),NQIOCH,NQNIO+1)
      IOTH = JBYT (NQIOCH(1),12,5)
      IF (NQNIO.NE.IOTH)           GO TO 96
      NQIOSV(1) = IXIO
      NQIOSV(2) = NQIOCH(1)

   49 NTOT = NTOT + NQNIO

C------            Select division

      IF (JQDIVI.NE.0)             GO TO 59
      IF (LS.LT.LQSTA(KQT+1))         GO TO 58
      IF (LS.GE.LQEND(KQT+20))        GO TO 58
      IF (LS.GE.LQEND(KQT+JQDVLL))    GO TO 54
      IF (LS.LT.LQEND(KQT+2))         GO TO 57
      JQDIVI = 3
      GO TO 55

   54 JQDIVI = JQDVSY
   55 IF (LS.LT.LQEND(KQT+JQDIVI))    GO TO 61
      JQDIVI = JQDIVI + 1
      GO TO 55

   57 JQDIVI = 1
      IF (LS.LT.LQSTA(KQT+2))         GO TO 61
   58 JQDIVI = 2
      GO TO 61

   59 IF (LSAME.EQ.0)               GO TO 61
      IF (LSAME.LT.LQSTA(KQT+JQDIVI))  GO TO 97
      IF (LSAME.GE.LQEND(KQT+JQDIVI))  GO TO 97

C------            Allocate space

   61 CALL MZRESV
      NQRESV = NQRESV - NTOT
      IF (NQRESV.LT.0)             GO TO 81
      IF (JQMODE.NE.0)             GO TO 63

C--                Division is mode forward

      NQLN  = LQEND(KQT+JQDIVI)
      LE    = NQLN + NTOT
      LQEND(KQT+JQDIVI) = LE
      GO TO 65

C--                Division is mode reverse

   63 LE    = LQSTA(KQT+JQDIVI)
      NQLN  = LE - NTOT
      LQSTA(KQT+JQDIVI) = NQLN

C----              Construct bank

   65 NZ = MIN (NZERO,NQND)
      IF (NZ.EQ.0)  NZ=NQND
      IF (NZ.LT.0)  NZ=0

      NST  = NQNIO + NQNL
      NQLS = NQLN + NST + 1
      CALL VZERO (LQ(KQS+NQLN+NQNIO+1),NQNL+NZ+9)

      NQIOCH(1) = MSBYT (NST+12,NQIOCH(1),1,16)
      DO 67  J=0,NQNIO
   67 LQ(KQS+NQLN+J) = NQIOCH(J+1)

      IQ(KQS+NQLS-5) = IDN
      IQ(KQS+NQLS-4) = NQID
      IQ(KQS+NQLS-3) = NQNL
      IQ(KQS+NQLS-2) = NQNS
      IQ(KQS+NQLS-1) = NQND
      IQ(KQS+NQLS)   = ISHFTL (NQNIO,18)

C------            Set up how to link

      IF   (NQBIA-1)         72, 73, 79

C--                JBIAS -ve, insert into tree

   72 LUP   = LQSUP
      KADR  = LQSUP + NQBIA
      LNEXT = LQ(KQS+KADR)
      IF (NQBIA.NE.0)              GO TO 77
      LUP   = LQ(KQS+LUP+1)
      GO TO 77

C--                JBIAS = +1, add to linear structure

   73 LNEXT = LQSUP
      IF (LNEXT.NE.0)              GO TO 74
      LUP  = 0
      KADR = LOCF (LSUPP(1)) - LQSTOR
#if defined(CERNLIB_APOLLO)
      KADR = RSHFT (IADDR(LSUPP(1)),2) - LQSTOR
#endif
      IF (KADR.LT.LQSTA(KQT+1))       GO TO 78
      IF (KADR.LT.LQSTA(KQT+21))      GO TO 98
      GO TO 78

   74 LUP  = LQ(KQS+LNEXT+1)
      KADR = LQ(KQS+LNEXT+2)

C----              Link bank into structure

   77 IF (LNEXT.EQ.0)              GO TO 78
      LQ(KQS+NQLS)    = LNEXT
      LQ(KQS+LNEXT+2) = NQLS

   78 LQ(KQS+NQLS+1) = LUP
      LQ(KQS+NQLS+2) = KADR

      LQ(KQS+KADR)   = NQLS

   79 LP(1) = NQLS
#if defined(CERNLIB_QDEBPRI)
      IF (NQLOGL.GE.2)
     + WRITE (IQLOG,9079) JQSTOR,JQDIVI,NQLS,LQSUP,NQBIA,
     +                                  NQID,NQNL,NQNS,NQND
 9079 FORMAT (' MZLIFT-  Store/Div',2I3,' L/LSUP/JBIAS=',2I9,I6,
     F' ID,NL,NS,ND= ',A4,2I6,I9)
#endif
#include "zebra/qtrace99.inc"
      RETURN

C----              Garbage collection

   81 LQMST(KQT+1) = LQSUP
      CALL MZGAR1
      LQSUP = LQMST(KQT+1)
      IF (NQBIA.GE.1)              GO TO 61
      KADR = LOCF (LSUPP(1)) - LQSTOR
#if defined(CERNLIB_APOLLO)
      KADR = RSHFT (IADDR(LSUPP(1)),2) - LQSTOR
#endif
      IF (KADR.LT.LQSTA(KQT+1))       GO TO 83
      IF (KADR.LT.LQSTA(KQT+21))      GO TO 61
   83 LSUPP(1) = LQSUP
      GO TO 61

C----              Error conditions

   98 NQCASE = 8
      NQFATA = 1
      IQUEST(18) = KADR
      GO TO 90

   97 NQCASE = 7
      NQFATA = 1
      IQUEST(18) = LSAME
      GO TO 90

   94 NQCASE = 4
      NQFATA = 1
      IQUEST(18) = LNEXT
      GO TO 90

   96 NQCASE = 1
   95 NQCASE = NQCASE + 2
   93 NQCASE = NQCASE + 1
   92 NQCASE = NQCASE + 1
   91 NQCASE = NQCASE + 1
   90 NQFATA = NQFATA + 7
      IQUEST(11) = LQSUP
      IQUEST(12) = NQBIA
      IQUEST(13) = NQID
      IQUEST(14) = NQNL
      IQUEST(15) = NQNS
      IQUEST(16) = NQND
      IQUEST(17) = ICHORG
#include "zebra/qtofatal.inc"
      END
*      ==================================================
#include "zebra/qcardl.inc"
